home *** CD-ROM | disk | FTP | other *** search
/ Hyper Stacks 1994 May / Hyper Stacks (Pacific HiTech)(1994)[Mac].iso / XCMDS&XFCNS / HCScrapUtils / RestoreScrap.Pas next >
Encoding:
Pascal/Delphi Source File  |  1988-07-13  |  2.8 KB  |  125 lines  |  [TEXT/MPS ]
  1. Program RestoreScrap;
  2. {
  3.     This module produces a HyperCard XCMD resource to restore the
  4.     current contents of the Clipboard from a resource with the given
  5.     type and ID in the current stack.  Call it from HyperCard as
  6.     follows:
  7.  
  8.     restoreScrap resType, resID
  9.  
  10.     Written by Lawrence D'Oliveiro 1988 January 13.
  11.     Last modified 1988 July 13.
  12. }
  13. {$C 'XCMD' 129 'RestoreScrap' 32}
  14. {$H 'XCmdHeader'}
  15. {$T 'XCMD'}
  16.  
  17.     Uses
  18.     MacIntf,
  19.     HyperXCmd;
  20.  
  21.     Procedure TheProc
  22.       (
  23.     ParamPtr : XCmdPtr
  24.       );
  25.       { actual code for the XCMD. }
  26.  
  27.     Var
  28.         TheResType : ResType;
  29.         TheResID : Integer;
  30.         TheResource : Handle;
  31.         TheResourceLength : LongInt;
  32.         Err : OSErr;
  33.  
  34.     Procedure GetScrapResource;
  35.       { gets the resource containing the scrap. }
  36.  
  37.         Procedure GetResTypeAndID;
  38.           { get resource type and ID. }
  39.  
  40.         Var
  41.             ResIDString : Str255;
  42.  
  43.           Begin
  44.         BlockMove(ParamPtr^.Params[1]^, @TheResType, 4);
  45.         ZeroToPas(ParamPtr, ParamPtr^.Params[2]^, ResIDString);
  46.         TheResID := StrToNum(ParamPtr, ResIDString)
  47.           End {GetResTypeAndID};
  48.  
  49.       Begin {GetScrapResource}
  50.         GetResTypeAndID;
  51.         TheResource := GetResource(TheResType, TheResID)
  52.       End {GetScrapResource};
  53.  
  54.     Procedure RestoreTheScrap;
  55.       { actually restore the scrap from TheResource. }
  56.  
  57.         Type
  58.         TypePtr = ^OSType;
  59.         SizePtr = ^LongInt;
  60.  
  61.         Var
  62.         ScrapPtr, ScrapOffset : LongInt;
  63.         ThisType : OSType;
  64.         ThisSize : LongInt;
  65.         Done : Boolean;
  66.  
  67.       Begin
  68.         HNoPurge(TheResource);
  69.         ScrapOffset := 0;
  70.         Err := ZeroScrap;
  71.         Done := Err <> NoErr;
  72.         While not Done do
  73.           Begin
  74.         If ScrapOffset > TheResourceLength - 8 then
  75.             Done := True;
  76.         If not Done then
  77.           Begin
  78.             HLock(TheResource);
  79.             ScrapPtr := Ord4(TheResource^);
  80.             ThisType := TypePtr(ScrapPtr + ScrapOffset)^;
  81.             ThisSize := SizePtr(ScrapPtr + ScrapOffset + 4)^;
  82.             Err := PutScrap(ThisSize, ThisType, Ptr(ScrapPtr + ScrapOffset + 8));
  83.             HUnlock(TheResource);
  84.             If Err <> NoErr then
  85.             Done := True
  86.           End {If};
  87.         If not Done then
  88.             ScrapOffset := ScrapOffset + ThisSize + 8 + Ord(Odd(ThisSize))
  89.           End {While};
  90.         HPurge(TheResource)
  91.       End {RestoreTheScrap};
  92.  
  93.     Procedure ReturnError
  94.       (
  95.         Error : Integer
  96.       );
  97.       { return error code as a string. }
  98.  
  99.         Var
  100.         ErrorString : Str255;
  101.  
  102.       Begin
  103.         NumToString(Error, ErrorString);
  104.         ParamPtr^.ReturnValue := PasToZero(ParamPtr, ErrorString)
  105.       End {ReturnError};
  106.  
  107.       Begin {TheProc}
  108.     GetScrapResource;
  109.     If TheResource <> Nil then
  110.       Begin
  111.         TheResourceLength := GetHandleSize(TheResource);
  112.         RestoreTheScrap;
  113.         If SystemEdit(3 {Copy}) then { so MultiFinder notices that scrap has changed }
  114.           { whoopee };
  115.         If Err <> NoErr then
  116.         ReturnError(Err)
  117.       End
  118.     else
  119.         ReturnError(resNotFound)
  120.       End {TheProc};
  121.  
  122. Begin {RestoreScrap}
  123.   { dummy mainline }
  124. End {RestoreScrap}.
  125.